{-# LANGUAGE ViewPatterns, DeriveDataTypeable #-}
----------------------------------------------------------------
--                                                            --
-- Module      :  LLVM.Code.Values                            --
-- License     :  GPL3                                        --
-- Mantainer   :  Mikhail Belyaev                             --
--                                                            --
----------------------------------------------------------------

module LLVM.Code.Values(
            Value(..),
            ValueTable(..),
            vtFromList,
            vtSize,
            getValue,
            getValueType,
            TypedValue(..)
       ) where

import Data.Generics(Typeable, Data)

import qualified Data.DataMap as M (size, fromList, lookup, Map)
import LLVM.Code.Types (TypeTable(..), Type)
import LLVM.Code.Shared (ValIndex(..))
import LLVM.Code.Values.Kinds
       (InstructionValue(..), ParameterValue(..), FunctionDeclValue(..),
        AliasValue(..), GlobalValue(..), ConstantValue, MetaValue(..))

data Value = ConstantV ConstantValue      |
             GlobalV GlobalValue          |
             AliasV AliasValue            |
             FunctionV FunctionDeclValue  |
             -- function-level only
             ParameterV ParameterValue    |
             MetaV MetaValue              |
             InstructionV InstructionValue  deriving (Show, Eq, Typeable, Data)

newtype ValueTable = ValueTable (M.Map ValIndex (Type,Value)) deriving (Show, Eq, Typeable, Data)

vtFromList :: [(ValIndex,(Type,Value))] -> ValueTable
vtFromList vs = ValueTable $ M.fromList vs

getValue :: ValueTable -> ValIndex -> Maybe Value
getValue (ValueTable mappings) vi = do { (_,ret) <- M.lookup vi mappings; return ret }
getValueType :: ValueTable -> ValIndex -> Maybe Type
getValueType (ValueTable mappings) vi = do { (ret,_) <- M.lookup vi mappings; return ret }

vtSize :: ValueTable -> ValIndex
vtSize (ValueTable mp) = fromIntegral $ M.size mp

class TypedValue a where
    getType :: a -> TypeTable -> Type
    toValue :: a -> Value
    toTVPair :: a -> TypeTable -> (Type,Value)
    toTVPair a tt = (getType a tt, toValue a)
